home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
BBS-Archive
/
Dev
/
GNU-TILE-FORTH.lha
/
src
/
forth.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-05-19
|
5KB
|
240 lines
/*
C BASED FORTH-83 MULTI-TASKING KERNEL APPLICATION: TILE FORTH
Copyright (C) 1988-1990 by Mikael R.K. Patel
Computer Aided Design Laboratory (CADLAB)
Department of Computer and Information Science
Linkoping University
S-581 83 LINKOPING
SWEDEN
Email: mip@ida.liu.se
Started on: 30 June 1988
Last updated on: 26 June 1990
Dependencies:
(cc) kernel.h, error.h, memory.h, io.h
Description:
A 32-bit Forth-83 Standard written in C. Illustrating the use of
the multi-tasking forth kernel, memory, io and error packages.
Allows parameters to be given to forth and selection of inter-
action symbol. Thus providing the basic interface for making forth
programs act as compile-and-go applications.
Copying:
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/* EXTERNAL DEFINITIONS */
#include "kernel.h"
#include "error.h"
#include "memory.h"
#include "io.h"
/* VERSION BANNER */
#define BANNER "TILE Forth version 3.33, Copyright (C) 1990, by Mikael Patel\n"
/* STRUCTURE SIZES */
#define DICTIONARYSIZE 1024L * 1024L
#define USERSIZE 1024L
#define PARAMSIZE 256L
#define RETURNSIZE 256L
/* ACCESS TO APPLICATION ARGUMENTS */
static INT32 ARGC;
static PTR32 ARGV;
static INT32 ARGS;
static CSTR ARGI;
/* ARGUMENT CHECK AND ACCESS MACROS */
#define ARGEQ(i, s) (*argv[i] == *s && *(argv[i] + 1) == *(s + 1))
#define ARGEV(i) (atol(argv[i] + 2))
/* APPLICATION IO DISPATCH. RUN ON IO-WAIT FOR PERIODICAL ACTIONS */
VOID io_dispatch()
{
/* Any application action which requires periodical attention */
}
/* EXAMPLE OF APPLICATION VOCABULARY */
VOID doarguments()
{
spush(ARGC - ARGS, INT32);
}
NORMAL_CODE(arguments, forth, "argc", doarguments);
VOID doargument()
{
if (!tos.INT32 && !ARGI)
tos.INT32 = *ARGV;
else
tos.INT32 = *((PTR32) (INT32) ARGV + tos.INT32 + ARGS);
}
NORMAL_CODE(argument, arguments, "argv", doargument);
/* MAIN WITH APPLICATION STARTUP OF FORTH TOP-LOOP */
main(argc, argv)
int argc;
char *argv[];
{
INT32 i, flag;
INT32 dictionarysize, usersize, paramsize, returnsize;
/* Initiate default size values */
dictionarysize = DICTIONARYSIZE;
usersize = USERSIZE;
paramsize = PARAMSIZE;
returnsize = RETURNSIZE;
/* Check for size arguments */
i = 1;
flag = i < argc;
while (flag) {
/* Assume no more arguments */
flag = FALSE;
/* Look for dictionary size argument */
if (ARGEQ(i, "-d")) {
dictionarysize = ARGEV(i);
flag = TRUE;
}
/* Look for parameter stack size argument */
if (ARGEQ(i, "-p")) {
paramsize = ARGEV(i);
flag = TRUE;
}
/* Look for return stack size argument */
if (ARGEQ(i, "-r")) {
returnsize = ARGEV(i);
flag = TRUE;
}
/* Look for user area size argument */
if (ARGEQ(i, "-u")) {
usersize = ARGEV(i);
flag = TRUE;
}
/* Check for more arguments to parse */
if (flag) {
i++;
flag = i < argc;
}
}
/* Initiate memory, error, io, and kernel */
io_initiate(BANNER);
error_initiate();
memory_initiate(dictionarysize);
kernel_initiate((ENTRY) &argument, (ENTRY) &arguments, usersize, paramsize, returnsize);
/* Set up argument counter and pointer */
ARGC = argc;
ARGV = (PTR32) argv;
ARGS = argc - 1;
ARGI = (CSTR) 0;
/* Load argument files before taking input from standard input */
for(; i < argc; i++) {
/* Look for argument or start symbol switch */
if (STREQ(argv[i], "-a")) {
ARGS = i;
i = argc;
}
else {
if (STREQ(argv[i], "-s")) {
ARGI = argv[i + 1];
ARGS = i + 1;
i = argc;
}
else {
/* Use the argument as an input file name and try loading it*/
if (io_infile(argv[i]) == IO_UNKNOWN_FILE) {
(VOID) fprintf(io_errf, "%s: file not found\n", argv[i]);
kernel_finish();
io_finish();
error_finish();
memory_finish();
exit(0);
}
else
doquit();
}
}
}
/* Use standard input as input stream */
(VOID) io_infile((CSTR) STDIN);
/* Check if there was a start symbol argument */
if (ARGI) {
/* Find the symbol in the vocabulary */
verbose = FALSE;
spush(ARGI, CSTR);
dofind();
if (tos.BOOL) {
dodrop();
docommand();
}
else
(VOID) fprintf(io_errf, "%s ??\n", ARGI);
}
else {
/* Else start the normal interaction loop */
verbose = TRUE;
doquit();
}
/* Clean up the kernel, io, error and memory package before exit */
kernel_finish();
memory_finish();
error_finish();
io_finish();
exit(0);
}